Vignette MorphoGraphX2R - time serie

library(colorRamps)
library(dplyr)
library(plotly)
library(purrr)
library(MorphoGraphX2R)

ply.dir <- system.file("extdata", "normalMesh/", package = "MorphoGraphX2R")

mesh.all <- map(list.files(ply.dir, recursive = TRUE, full.names = TRUE),
                ~ modified_read.ply(file = .x, ShowSpecimen = FALSE))
#> [1] "Object has 7802 faces and 4180 vertices."
#> [1] "Object has 7689 faces and 4170 vertices."
#> [1] "Object has 6339 faces and 3455 vertices."
#> [1] "Object has 5731 faces and 3137 vertices."
#> [1] "Object has 6147 faces and 3354 vertices."


graph.dir <- system.file("extdata", "cellGraph/", package = "MorphoGraphX2R")

cellGraph.all <- map(list.files(graph.dir, recursive = TRUE, full.names = TRUE), ~modified_read.cellGraph(fileCellGraph = .x, header_max = 30))

meshColors.all <- list(NULL, NULL, NULL, NULL, NULL)

plotlySlider <- function(meshExample,
                     graphExample,
                     meshColors,
                     display,
                     defaultColor = list("#CCCCFF", 0.2),
                     heatmapParam = "GeometryArea"
){
  makeColorScale <- FALSE
  if (display == 'labels'){
    opacity <- 1
    if (is.null(meshColors)){
      meshColors <- meshExample$allColors$Col_label
    }
    if (ncol(meshColors)>1){
      color <- NULL
      for (i in 1:ncol(meshColors)){
        color[i] <-  setdiff(unique(meshColors[,i]), "#000000") #I remove black vertices
      } # to be more general, remove any color shared by two vertices
    }else{
      color <- meshColors
    }
  } else if (display == 'none'){
    color <- rep(defaultColor[[1]], ncol(meshExample$it)) # "#00FFFF"
    opacity <- defaultColor[[2]]
  } else if (display == 'heatmap'){
    if (is.numeric(meshColors) == TRUE && is.null(heatmapParam) == TRUE ){
      makeColorScale <- TRUE
      colorCut <- cut(pull(meshColors), 15,
                      labels =  matlab.like(15)
      )
      color <- as.character(colorCut)
      opacity <- 1
    }else if (is.null(heatmapParam) == FALSE){
      meshColors <- left_join(meshExample$it_label, graphExample$vertices) %>%
        select_(., heatmapParam)
      makeColorScale <- TRUE
      colorCut <- cut(pull(meshColors), 15,
                      labels =  matlab.like(15)
      )
      color <- as.character(colorCut)
      opacity <- 1
    }else{
      warning("Provide continous variable for heatmap or valid heatmap parameter.")
    }
  }
  
  
  trace2 <- list(type="mesh3d",
                 x = meshExample$vb[1,],
                 y = meshExample$vb[2,],
                 z = meshExample$vb[3,],
                 i = meshExample$it[1,]-1, # NB indices start at 0
                 j = meshExample$it[2,]-1,
                 k = meshExample$it[3,]-1,
                 facecolor = color,
                 opacity = opacity,
                 visible = FALSE
  )
  
  
  if (makeColorScale){
    
    trace4 <- list(x = c(100,1,200),
                   y = c(200,1,1),
                   z = c(1,500,3),
                   marker = list(
                     autocolorscale = FALSE,
                     cmax = round(max(meshColors)),#2.5,
                     cmin = round(min(meshColors)),#0,
                     color = c("#0000aa", "#99ff99", "#aa0000"),
                     colorbar = list(
                       x = 1.2,
                       y = 0.5,
                       len = 1,
                       thickness = 15,
                       tickfont = list(size = 12),
                       titlefont = list(size = 20)
                     ),
                     colorscale = purrr::map2(.x = seq(0,1, len=15),
                                              .y = matlab.like(15),
                                              ~ list(.x, .y)),
                     line = list(width = 0),
                     opacity = 0.1,
                     showscale = TRUE,
                     size = 20,
                     symbol = "circle"
                   ),
                   mode = "markers",
                   opacity = 0,
                   type = "scatter3d"
    )
  }else{
    trace4 <- NULL
  }
  
  meshCellcenter <- graphExample$vertices[,c("label","x", "y", "z")]
  
  list(trace2, trace4, meshCellcenter)
  #facecolor: one color per triangle (e.g. length(facecolor) == length(i))
}

all.trace <- pmap(list(meshExample = mesh.all,
                       graphExample = cellGraph.all,
                       meshColors = meshColors.all,
                       display = 'heatmap'),`plotlySlider`)

all.trace[[1]][[1]]$visible = TRUE

layout <- list(
  scene = list(
    xaxis = list(
      backgroundcolor = "rgb(230,230,230)", 
      gridcolor = "rgb(255,255,255)", 
      showbackground = TRUE, 
      zerolinecolor = "rgb(255,255,255"
    ), 
    yaxis = list(
      backgroundcolor = "rgb(230,230,230)", 
      gridcolor = "rgb(255,255,255)", 
      showbackground = TRUE, 
      zerolinecolor = "rgb(255,255,255"
    ), 
    zaxis = list(
      backgroundcolor = "rgb(230,230,230)", 
      gridcolor = "rgb(255,255,255)", 
      showbackground = TRUE, 
      zerolinecolor = "rgb(255,255,255"
    )
  ), 
  title = "My mesh", 
  xaxis = list(title = "m[, 1]"), 
  yaxis = list(title = "m[, 2]")
)

p <- plot_ly()

steps <- list()
for (t in 1:length(all.trace)){
  traceCount <- 0
  p <- add_trace(p, x=all.trace[[t]][[1]]$x,
                 y=all.trace[[t]][[1]]$y,
                 z=all.trace[[t]][[1]]$z,
                 facecolor=all.trace[[t]][[1]]$facecolor,
                 i=all.trace[[t]][[1]]$i,
                 j=all.trace[[t]][[1]]$j,
                 k=all.trace[[t]][[1]]$k,
                 type=all.trace[[t]][[1]]$type,
                 visible = all.trace[[t]][[1]]$visible,
                 hoverinfo = 'none')
  traceCount <- 1
  
  if (!is.null(all.trace[[t]][[2]])){
    traceCount <- traceCount+1
    p <- add_trace(p,
                   x = all.trace[[t]][[3]]$x,
                   y = all.trace[[t]][[3]]$y,
                   z = all.trace[[t]][[3]]$z,
                   text = as.character(all.trace[[t]][[3]]$label),
                   hoverinfo = 'text',
                   marker = all.trace[[t]][[2]]$marker,
                   mode = all.trace[[t]][[2]]$mode,
                   opacity = all.trace[[t]][[2]]$opacity,
                   type = all.trace[[t]][[2]]$type,
                   showlegend = FALSE#,
                   # hoverinfo = 'none'
    )
  }
  if (!is.null(all.trace[[t]][[3]])){ # show cell center
    traceCount <- traceCount+1
    p <- add_trace(p, x = all.trace[[t]][[3]]$x,
                   y = all.trace[[t]][[3]]$y,
                   z = all.trace[[t]][[3]]$z,
                   text = as.character(all.trace[[t]][[3]]$label),
                   hoverinfo = 'text',
                   type = "scatter3d",
                   mode = "markers",
                   marker=list(color = 'rgb(255, 255, 255)',
                               size = 10),
                   opacity = 0,
                   showlegend = FALSE
    )
  }
  
  p <- layout(p, scene=layout$scene, title=layout$title, xaxis=layout$xaxis, yaxis=layout$yaxis)
  
  if (traceCount == 1){
    step <- list(args = list('visible', rep(FALSE, length(all.trace))),
                 method = 'restyle')
    step$args[[2]][t] = TRUE 
  }else if (traceCount == 2){ # slider takes in account all existing traces
    step <- list(args = list('visible', rep(FALSE, length(all.trace)*2)),
                 method = 'restyle')
    k <- t + (t-1)
    step$args[[2]][k] = TRUE  
    step$args[[2]][k+1] = TRUE
  }else if (traceCount == 3){
    step <- list(args = list('visible', rep(FALSE, length(all.trace)*3)),
                 method = 'restyle')
    increment <- seq(0, (length(all.trace)-1)*2, 2)
    k <- t + increment[t]
    step$args[[2]][k] = TRUE  
    step$args[[2]][k+1] = TRUE
    step$args[[2]][k+2] = TRUE
  }
  
  steps[[t]] = step 
}


p <- p %>%
  layout(sliders = list(list(active = 3,
                             currentvalue = list(prefix = "Frame: "),
                             steps = steps)))
p